perm filename INTERP.PAL[HAL,HE]9 blob
sn#158956 filedate 1975-05-15 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00017 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00003 00002 .SBTTL Interpreter
C00007 00003 Interpreter itself: INTERP
C00012 00004 GETARG, GETSCA, GETVEC, GETTRN
C00016 00005 Variable declaration: MVAR, KVAR
C00019 00006 Stack ops: GTVAL, IGTVAL, CHNGE, ICHNGE, PUSH, POP, COPY, REPLACE, FLUSH
C00023 00007 Flow-of-control: PROC, RETURN
C00029 00008 FORCHK, JUMP, JUMPC
C00032 00009 SPAWN, SPROUT, TERMINATE
C00040 00010 return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG
C00046 00011 Vector utilities: UNITV, CROSV
C00052 00012 Return vectors: SVMUL, TVMUL, VMAKE, VADD
C00056 00013 Return a trans: TMAKE, TTMUL
C00060 00014 Motion: MOVE
C00062 00015 Condition monitors: CMMAK
C00068 00016 CMENBL, CMDSBL, CMDEST, CMTRIG, CMSKED, CMUNCR, CMBWT
C00074 00017 Debugging aids: PRINT
C00075 ENDMK
C⊗;
.SBTTL Interpreter
COMMENT ⊗
Register uses in the interpreter:
R3 interpreter stack pointer
R4 points to interpreter status block
R2 not used by the main interpreter loop. Can be munged by
any primary interpreter routine.
Each interpreter has a stack which it uses to store pointers to
currently "open" variables. During the course of a calculation,
operands and temporary result cells will be open in this fashion.
The "interpreter stack" is pointed to by R3. When a new interpreter
is sprouted, it is given a new stack area. Each interpreter has
certain status information which facilitates transfer of control
between interpreters. This information is kept in the interpreter
status block, which is always pointed to by R4. Most important are
the IPC, the Interpreter Program Counter, the ENV, which points to
the local environment, and LEV, which stores the current lexical
level.
Each procedure has an environment, which is a data area holding
information vital to that procedure. This includes pointers to all
the variables local to that procedure, and return information. ⊗
INSTSZ == 20 ;Size of an interpreter stack
;Interpreter status block
II == 0
XX IPC ;Interpreter program counter
XX STKBAS ;Location of start of stack area. Needed
;for eventual reclamation.
XX ENV ;Location of local environment
XX LEV ;Lexical level of current execution
XX STA ;Status bits for condition codes: 0 means all well.
XX PCB ;Location of process control block (for reclamation)
XX EVT ;The event to signal as this interpreter goes away
XX CMCB ;Pointer to c-m control block if this is a checker or a body.
; XX ICR ;Interpreter cross-reference (to HAL code)
ISBS == II/2 ;Size (in words) of interpreter status block
;Fixed fields in the environment of each process
II == 0
XX SLINK ;Pointer to environment of next (outer, lower
; numbered) block
XX OLEV ;Old level. The lexical level of calling process.
XX OENV ;Old environment, the one for the calling process.
XX OIPC ;Old IPC. Program counter for calling process.
XX LVARS ;First location where pointers to local variables go
;Interpreter itself: INTERP
.MACRO BMPIPC ;
ADD #2,IPC(R4) ;Bump IPC
.ENDM ;
.MACRO CCC ;Clear condition code
CLR R0 ;Clear condition code
.ENDM
.MACRO SCC ;Set condition code
MOV #1,R0 ;Set condition code
.ENDM
INTERP:
INT1: MOV @IPC(R4),R0 ;R0 ← next instruction
BLE INTER1 ;Instruction out of range
CMP R0,#INSEND ;Is instruction too large?
BHI INTER1 ;Yes.
BMPIPC ;Bump IPC
JSR PC,@INTOPS(R0) ;Call the appropriate routine
BR INTCPL(R0) ;R0 should have an completion code. Branch accordingly.
INTCPL: BR INTSTS ;No error. Gather statistics.
HALERR INTMS2 ;Error.
INTSTS: BR INT1 ;No statistics code written yet.
INTER1: HALERR INTMS1
INTMS1: ASCIE /INTERPRETER INSTRUCTION OUT OF RANGE/
INTMS2: ASCIE /INTERPRETED INSTRUCTION RETURNED FAILURE/
.MACRO MAKEOP CNAME, ANAME ;Compiler name, Address name
XX CNAME
ANAME
.ENDM
INTOPS: INTER1 ;Illegal instruction
.INSRT INTOPS.PAL[HAL,HE]
;The interpreter operation table
INSEND = II ;Marks the end of the instructions
; GETARG, GETSCA, GETVEC, GETTRN
GETARG:
COMMENT ⊗
Arguments:
R0=variable name: high byte is lexical level, low byte is offset.
R4=pointer to interpreter status block.
Result:
R0← pointer to address of desired variable.
R1 clobbered.
This routine returns in R0 a pointer to the location in the current
environment (or, if necessary, more global environment) which
points to the variable which is named in R0. ⊗
MOV R2,-(SP) ;Save R2
MOVB R0,R1 ;R1 ← Offset desired
CLRB R0 ;
SWAB R0 ;R0 ← Lexical level
MOV ENV(R4),R2 ;R2 ← LOC[local environment]
SUB LEV(R4),R0 ;R0 ← Difference in levels: desired-got
BEQ GTRG1 ;Diff=0; can use R2 as pointer at right base.
BHI GTERR ;If diff>0, then value inaccessible.
GTRG2: MOV SLINK(R2),R2;Must go up a level. R2 ← LOC[more global environment]
INC R0 ;R0 ← New difference in levels
BNE GTRG2 ;If not yet good, then move up another level
GTRG1: ADD R2,R1 ;R1 ← environment + offset = location of desired pointer
MOV (SP)+,R2 ;Restore R2.
MOV R1,R0 ;
RTS PC ;Done.
GTERR: HALERR GTMS1
GTMS1: ASCIE /ATTEMPT TO ACCESS UNAVAILABLE VARIABLE/
GETSCA: ;Gets place for a scalar result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
MOV #2,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GETVEC: ;Gets place for a vector result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
MOV #10,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
GETTRN: ;Gets place for a trans result, and places a pointer on
;the interpreter stack. Location is returned in R0.
;Simple procedure.
MOV #40,R0 ;Number of words needed
JSR PC,GTFREE ;R0 ← LOC[new block]
; MOV #RES,R0 ;Temporary kludge. Delete this line in final runs.
MOV R0,-(R3) ;Push new value cell pointer on interpreter stack.
RTS PC ;Done
;Variable declaration: MVAR, KVAR;
MVAR:
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, a fresh graph node
is created (with no value) and a pointer to it is placed in the
environment at the desired offset, current level. ⊗
MOV @IPC(R4),-(SP) ;push offset
BEQ MVAR1 ;If none, done
BMPIPC ;Bump IPC
CLR R0 ;The new graph node should get no value cell.
JSR PC,MAKEGN ;R0 ← LOC[a new graph node]
ADD ENV(R4),(SP);stack pointer into environment
MOV R0,@(SP)+ ;Point the environment to the graph node
BR MVAR ;Repeat
MVAR1: TST (SP)+ ;Clean off stack
BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
KVAR:
COMMENT ⊗ A list of arguments, each of which is an offset. This list
is terminated by a zero entry. For each argument, the corresponding
graph node is destroyed in the current environment. Any function in
the graph structure is thereby released. (Attempt is made to
validate any dependents first.) ⊗
MOV @IPC(R4),R1 ;R1 ← offset
BEQ KVAR1 ;If none, done
BMPIPC ;Bump IPC
ADD ENV(R4),R1 ;R1 ← LOC[pointer at graph node]
MOV (R1),R0 ;R0 ← LOC[graph node]
CLR (R1) ;Remove the pointer in the environment
JSR PC,DELGN ;Get this guy deleted
BR KVAR ;Repeat
KVAR1: BMPIPC ;Bump IPC
CCC ;Clear condition code
RTS PC ;Done
;Stack ops: GTVAL, IGTVAL, CHNGE, ICHNGE, PUSH, POP, COPY, REPLACE, FLUSH
GTVAL:
COMMENT ⊗ The argument is a level-offset pair. The variable
referenced by that pair is examined and a pointer to its value cell
is placed on the stack. ⊗
MOV @IPC(R4),R0 ;Pick up level-offset name of argument
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[desired graph node]]
MOV (R0),R0 ;R0 ← LOC[desired graph node]
CALL GETVAL,<R0>;R0 ← value
MOV R0,-(R3) ;Push value on interpreter stack.
BEQ GTVL1 ;But if 0, then bug
CCC ;Clear condition code.
RTS PC ;Done
GTVL1: HALERR GTVMES ;Complain
SCC ;Set condition code
RTS PC ;Done
GTVMES: ASCIE </GTVAL FOUND A NULL VALUE. MAY CONTINUE/>
IGTVAL:
COMMENT ⊗ Immediate version of GTVAL. The argument points directly
to the graph node whose value is desired. A pointer to the value
cell is placed on the stack. ⊗
MOV @IPC(R4),R0 ;R0 ← LOC[desired graph node]
BMPIPC ;Bump IPC
CALL GETVAL,<R0>;R0 ← value
MOV R0,-(R3) ;Push value on interpreter stack.
CCC ;Clear condition code.
RTS PC ;Done
CHNGE:
COMMENT ⊗ Pops the value from top of stack into the graph structure
pointed to by the level-offset pair given in the argument. ⊗
MOV @IPC(R4),R0 ;Pick up level-offset name of argument
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[Desired graph node]]
MOV (R0),R0 ;R0 ← LOC[Desired graph node]
CALL CHANGE,<R0,(R3)>
POP: TST (R3)+ ;Pop stack
CCC ;Clear condition code.
RTS PC ;Done
ICHNGE:
COMMENT ⊗ Immediate version of CHNGE. Pops the value from top of
stack into the graph structure pointed to directly by the argument. ⊗
MOV @IPC(R4),R0 ;R0 ← LOC[desired graph node]
BMPIPC ;Bump IPC
CALL CHANGE,<R0,(R3)>
TST (R3)+ ;Pop stack
CCC ;Clear condition code.
RTS PC ;Done
PUSH: MOV @IPC(R4),-(R3);Put argument directly on stack
BMPIPC ;Bump IPC
CCC ;Clear condition code.
RTS PC ;Done
COPY: MOV @IPC(R4),R0 ;Pick up argument.
BMPIPC ;Bump IPC
ADD R0,R0 ;Double R0 to make it in bytes
ADD R3,R0 ;R0 ← LOC[stack element to be copied to top]
MOV (R0),-(R3) ;Copy it onto top of stack.
CCC ;Clear condition code.
RTS PC ;Done
REPLAC: MOV @IPC(R4),R0 ;Pick up argument.
BMPIPC ;Bump IPC
ADD R0,R0 ;Double R0 to make it in bytes
ADD R3,R0 ;R0 ← LOC[stack element to be copied into]
MOV -(R3),(R0) ;Copy top of stack into it.
CCC ;Clear condition code.
RTS PC ;Done
FLUSH: MOV STKBAS(R4),R3;Reset the stack base.
CCC ;Clear condition code.
RTS PC ;Done
;Flow-of-control: PROC, RETURN
PROC:
;Procedure call. Arguments:
; Destination.
; List of variables which are to be inserted in appropriate
; locations in the local storage of procedure. These are
; in the format variable (ie level-offset pair), new offset
; (right justified in the second word).
; There is a zero word to finish these.
;At the destination address can be found:
II == 0
XX FSLGTH ;Number of words to get from free storage
;for local variable pointers
XX PLEV ;Lexical level of procedure
DSLGTH == II ;Number of words before code starts
;Value parameters should have first been copied first into local temps
; (which have been arranged by the compiler), and then the temps are
; passed by reference. Eventual problem: to know which variables to
; really kill as the procedure is exited.
MOV @IPC(R4),R2 ;R2 ← LOC[destination]
BMPIPC ;Bump IPC
MOV FSLGTH(R2),R0 ;R0 ← Number of words to get.
JSR PC,GTFREE ;R0 ← LOC[block with that number of words]
;initialize pointer to lexical level:
MOV PLEV(R2),R1 ;R1 ← Lexical level of procedure
MOV ENV(R4),R2 ;R2 ← LOC[current environment]
SUB LEV(R4),R1 ;R1 ← Difference in levels: desired-got
BEQ PRC1 ;Diff=0; can use R2 as pointer at right environment.
PRC2: MOV SLINK(R2),R2;No, must go up a level. R2 ← LOC[base of upper area]
INC R1 ;R1 ← New difference in levels
BNE PRC2 ;If not yet good, then move up another level
PRC1: MOV R2,SLINK(R0);SLINK[new environment] ← correct global environment
;Put copies of local variables in new area
MOV R0,-(SP) ;Stack LOC[new environment]
MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
BEQ PRC3 ;If there are no more, go to next phase
PRC4: BMPIPC ;Else bump IPC
JSR PC,GETARG ;R0 ← LOC[LOC[graph node]]
MOV @IPC(R4),R1 ;R1 ← offset in new block
BMPIPC ;Bump IPC
ADD (SP),R1 ;R1 ← LOC[place in new environment to put pointer]
MOV (R0),(R1) ;new environment gets pointer to LOC[argument graph node]
MOV @IPC(R4),R0 ;R0 ← level-offset pair for an argument
BNE PRC4 ;If there are more, go back and treat them
PRC3: BMPIPC ;Bump IPC one last time
;Save the old context in the new area
MOV (SP)+,R1 ;R1 ← LOC[new environment]
MOV LEV(R4),OLEV(R1) ;Store the old level
MOV ENV(R4),OENV(R1) ;Store the old environment location
MOV IPC(R4),OIPC(R1) ;Store the return address
;Set up the new context for procedure
MOV PLEV(R2),LEV(R4) ;New lexical level
MOV R1,ENV(R4) ;New environment location
ADD #DSLGTH,R2 ;R2 ← Place where execution should begin
MOV R2,IPC(R4) ;New program counter
CCC ;Clear condition code.
RTS PC ;Done
RETURN:
;Returns from a procedure call to calling program. Since variables are
;passed by reference, it is not necessary to do any copying of values.
;All that is needed is to restore the context of the caller and to
;discard the display.
MOV ENV(R4),R0 ;R0 ← LOC[current environment]
MOV OLEV(R0),LEV(R4) ;Restore the old lexical level
MOV OENV(R0),ENV(R4) ;Restore the old environment
MOV OIPC(R0),IPC(R4) ;Restore the IPC
JSR PC,RLFREE ;Release storage of old display
CCC ;Clear condition code.
RTS PC ;Done
; FORCHK, JUMP, JUMPC
FORCHK:
;Assume that the stack has, from surface in, the increment, the
; final value, and the control variable's value, all of which are
; scalar values. If (FINAL-CONVAR)*(INCREMENT) ≥ 0 then this is a
; no-op; otherwise, jump to the destination.
;Arguments: destination.
LDF @2(R3),AC0 ;AC0 ← final value
SUBF @4(R3),AC0 ;AC0 ← final - current
MULF @(R3),AC0 ;AC0 ← (final - current)*increment
MOV @IPC(R4),R0 ;R0 ← destination
BMPIPC ;Bump IPC
CFCC ;
BGE FOR1 ;Shall this be a no-op?
MOV R0,IPC(R4) ;No; set new IPC.
FOR1: CLR R0 ;
RTS PC ;Done
JUMP:
;Takes one argument: the new address.
MOV @IPC(R4),IPC(R4)
CCC ;Clear condition code.
RTS PC ;Done
JUMPC: ;Interpreter routine
COMMENT ⊗ Two arguments: the condition and the destination address.
The condition queries the top of the stack and pops it, assuming it
to be a scalar. The interpreter jumps to the destination address if
the condition is satisfied. The possible conditions are 0(Never),
1(L), 2(E), 3(LE), 4(Always), 5(GE), 6(NE), 7(G). Note that
comparisons of equality must be exact to floating precision. ⊗
MOV @IPC(R4),R2 ;R2 ← condition
BMPIPC ;Bump IPC
BLT JMPCERR ;If out of range, complain.
MOV R2,R0 ;
SUB #7,R0 ;
BGT JMPCERR ;
MOV (R3)+,R0 ;R0 ← LOC[arg]
LDF (R0),AC0 ;AC0 ← arg
ADD R2,R2 ;
ADD R2,R2 ;Multiply condition by 4.
CFCC ;
JMP JMPC3(R2) ;Go to the right test.
JMPC3: BR JMPC1 ;N always fail
BR JMPC4 ;
BGE JMPC1 ;L
BR JMPC4 ;
BNE JMPC1 ;E
BR JMPC4 ;
BGT JMPC1 ;LE
BR JMPC4 ;
TST R0 ;A never fail
BR JMPC4 ;
BLT JMPC1 ;GE
BR JMPC4 ;
BEQ JMPC1 ;NE
BR JMPC4 ;
BLE JMPC1 ;G
JMPC4: MOV @IPC(R4),IPC(R4) ;Succeed
BR JMPC2 ;
JMPC1: BMPIPC ;Fail. Bump IPC
JMPC2: CCC ;Clear condition code.
RTS PC ;Done
JMPCER: HALERR JMPCMS ;
JMPCMS: ASCIE </ILLEGAL JUMPC CODE/>
; SPAWN, SPROUT, TERMINATE
PDBSTA == 40 ;Process Descriptor Block Status Word
PDBR0 == 60 ;Where R0 is saved
PDBR1 == 62 ;Where R1 is saved
PDBR2 == 64 ;Where R2 is saved
PDBR3 == 66 ;Where R3 is saved
PDBR4 == 70 ;Where R4 is saved
PDBR5 == 72 ;Where R5 is saved
PDBSP == 74 ;Where SP is saved
PDBPC == 76 ;Where PC is saved
PDBSSV == 104 ;Process Descriptor Block Stack Save Length Word
SPAWN: ;Utility routine
COMMENT ⊗ Takes two arguments: In R0, the IPC of the interpreter to
spawn, and in R1, the event (if any) to put in EVT of the new
interpreter. The inferior will have the same environment as the
superior. Creates an interpreter status block, stack, process
descriptor, and is ready for a SCHEDU when it returns the process
descriptor in R0. ⊗
MOV R1,-(SP) ;Save the EVT
MOV R0,-(SP) ;Save the new IPC
MOV #ISBS,R0 ;R0 ← Size (in words) of an interpreter status block
JSR PC,GTFREE ;R0 ← LOC[new interpreter status block]
MOV (SP)+,IPC(R0);new IPC ← first argument
MOV ENV(R4),ENV(R0) ;new ENV ← old ENV
MOV LEV(R4),LEV(R0) ;new LEV ← old LEV
MOV (SP)+,EVT(R0);new EVT ← second argument.
MOV R0,-(SP) ;Save LOC[new interpreter status block]
MOV #INSTSZ,R0 ;R0 ← Size needed for an interpreter stack
JSR PC,GTFREE ;R0 ← LOC[new interpreter stack]
MOV (SP)+,R1 ;R1 ← LOC[new interpreter status block]
MOV R0,STKBAS(R1) ;Store away new stack base
ADD #2*INSTSZ,R0 ;R0 ← LOC[top of new stack] (INSTSZ is in bytes)
MOV R1,-(SP) ;Save R1
MOV R0,-(SP) ;Save R0
MOV #210,R0 ;Room for process descriptor
JSR PC,GTFREE ;R0 ← LOC[new process descriptor]
MOV #UFPUSE+UGPSAV,PDBSTA(R0);Use floating point, use saved registers.
MOV #100,PDBSSV(R0) ;Length of stack to be saved.
; MOV (R2),PDBR2(R0) ;Transfer register 2 (not currently necessary)
MOV (SP)+,R1 ;R1 ← LOC[new interpreter stack top]
MOV R1,PDBR3(R0) ;Store away new interp stack pointer (reg 3)
MOV (SP)+,R1 ;R1 ← LOC[new ISB]
MOV R0,PCB(R1) ;Store away LOC[PCB] in new ISB
MOV R1,PDBR4(R0) ;Store away LOC[ISB] in reg 4 of PCB
MOV R5,PDBR5(R0) ;Store away reg 5
MOV SP,R1 ;
TST (R1)+ ;
MOV R1,PDBSP(R0) ;Store away the new stack pointer (reg 6)
MOV #INTERP,PDBPC(R0);Store away the new PC
ADD #PDBSTA,R0 ;R0 ← middle of Process Descriptor Block
RTS PC ;Done
; This is the appropriate scheduling command:
; SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
SPROUT: ;Interpreter routine
COMMENT ⊗ Arguments: One address in pseudo-code for each of the
several forks starting up, followed by a 0 word. This is to be used
only for cobegins, not for servos. Each new interpreter is given an
interpreter status block and is then scheduled. As each terminates,
it signals its defining event. Since each of these has the same
event, the current interpreter need only wait until they all happen.
⊗
MOV R3,-(SP) ;Save R3. Caution: cannot use interpreter stack now.
CLR R3 ;R3 is the count of how many inferiors to spawn.
EVMAK ;-(SP) ← Event identifier for communication with infs.
SPR2: MOV @IPC(R4),R0 ;R0 ← next argument (IPC)
BEQ SPR1 ;If zero, then we have spawned all the inferiors.
BMPIPC ;Bump IPC
INC R3 ;Count it.
MOV (SP),R1 ;R1 ← event for the inferior EVT
JSR PC,SPAWN ;R0 ← process control block of new interpreter
SCHEDU R0,#INTERP,#0,#2;Cause the new process to be started, suspended
BR SPR2 ;Go handle the next inferior.
SPR1: BMPIPC ;Bump IPC
SPR4: DEC R3 ;Another wait to be done?
BMI SPR3 ;No, we are finished.
EVWAIT (SP) ;Wait for an inferior to come back.
BCC SPR4 ;If all well, wait for the next one.
HALERR SPRMES ;The event was killed!
SPR3: EVKIL (SP)+ ;Kill the event now, remove from stack
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code.
RTS PC ;Done
SPRMES: ASCIE /BAD RETURN FROM INFERIOR/
TERMINATE: ;Interpreter routine
;End this interpreter.
MOV EVT(R4),R0 ;R0 ← event to announce imminent demise
BEQ TERM1 ;If there is one
EVSIG R0 ;Announce that we are about to disappear.
TERM1: MOV STKBAS(R4),R0 ;Reclaim interpreter stack
JSR PC,RLFREE ;
MOV PCB(R4),R0 ;Reclaim process control block (may be dangerous)
JSR PC,RLFREE ;
MOV R4,R0 ;Reclaim Interpreter Status Block
JSR PC,RLFREE ;
DISMIS ;Go away
;return scalars: SADD, SSUB, SMUL, SDIV, SNEG, VDOT, PVDOT, VMAG
COMMENT ⊗ All timings are averages of 1000 runs. They take into
account the cost of the RTS but not the JSR. It is assumed that
GETSCA and GETVEC take no time. All routines on this page are
interpreter routines. ⊗
;30 microseconds
SADD: ;Scalar ← Scalar + Scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
ADDF @(R3)+,AC0 ;AC0 ← arg2 + arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
SSUB: ;Scalar ← Scalar - Scalar
LDF @2(R3),AC0 ;AC0 ← arg 1
SUBF @(R3)+,AC0 ;AC0 ← arg1 - arg2
TST (R3)+ ;Move past first argument
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;30 microseconds
SMUL: ;Scalar ← scalar * scalar
LDF @(R3)+,AC0 ;AC0 ← arg 2
MULF @(R3)+,AC0 ;AC0 ← arg2 * arg1
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;33 microseconds
SDIV: ;Scalar ← Scalar / Scalar
LDF @(R3)+,AC1 ;AC1 ← arg 2
LDF @(R3)+,AC0 ;AC0 ← arg 1
DIVF AC1,AC0 ;AC0 ← arg1 / arg2
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;26 microseconds
SNEG: ;Scalar ← -Scalar
LDF @(R3)+,AC0 ;AC0 ← arg
NEGF AC0 ;AC0 ← -arg
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
CCC ;Clear condition code.
RTS PC ;Done
;96 -- 116 microseconds
VDOT: ;Scalar ← Vector dot Vector
;S ← (X1X2 + Y1Y2 + Z1Z2) / W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #3,R2 ;R2 ← 3: Length of vector
VDV1: LDF (R0)+,AC1 ;Form sum of products of first 3 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,VDV1 ;Loop until all 3 fields done.
DIVF (R0),AC0 ;Divide by W1
DIVF (R1),AC0 ;Divide by W2. AC0 now has answer.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
CCC ;Clear condition code.
RTS PC ;Done
;103 -- 116 microseconds
PVDOT: ;Scalar ← Plane dot Vector
;S ← X1X2 + Y1Y2 + Z1Z2 + W1W2
MOV R2,-(SP) ;Save R2.
MOV (R3)+,R1 ;R1 ← LOC[arg 2]
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
CLRF AC0 ;AC0 ← 0. Running total
MOV #4,R2 ;R2 ← 4: Length of vector and weight
PDV1: LDF (R0)+,AC1 ;Form sum of products of all 4 terms
MULF (R1)+,AC1 ;
ADDF AC1,AC0 ;
SOB R2,PDV1 ;Loop until all 3 fields done.
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store result
MOV (SP)+,R2 ;Restore R2
CCC ;Clear condition code.
RTS PC ;Done
;199 -- 207 microseconds
VMAGN: ;Scalar ← Norm (vector)
;S ← SQRT(XX + YY+ ZZ) / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Push LOC[W] onto system stack, to save across SQRTF
JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
DIVF @(SP)+,AC0 ;AC0 ← AC0 / W
JSR PC,GETSCA ;R0 ← -(R3) ← LOC[new scalar block]
STF AC0,(R0) ;Store answer
CCC ;Clear condition code.
RTS PC ;Done
;Vector utilities: UNITV, CROSV
COMMENT ⊗ These are not currently being used
;281 -- 286 microseconds
UNITV: ;Vector ← V / Norm(V)
;S ← SQRT(XX + YY+ ZZ) / W
MOV (R3),R1 ;R1 ← LOC[arg]
LDF (R1)+,AC0 ;AC0 ← X
MULF AC0,AC0 ;AC0 ← XX
LDF (R1)+,AC1 ;AC1 ← Y
MULF AC1,AC1 ;AC1 ← YY
ADDF AC1,AC0 ;AC0 ← XX + YY
LDF (R1)+,AC1 ;AC1 ← Z
MULF AC1,AC1 ;AC1 ← ZZ
ADDF AC1,AC0 ;AC0 ← XX + YY + ZZ
MOV R1,-(SP) ;Save R1 across SQRTF
JSR PC,SQRTF ;AC0 ← SQRT(XX + YY + ZZ)
MOV (SP)+,R1 ;Restore R1
DIVF (R1),AC0 ;AC0 ← Norm = SQRT / W
MOV (R3)+,R1 ;R1 ← LOC[arg]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R2 ;R2 ← count of fields
UNITV1: LDF (R1)+,AC1 ;AC1 ← field of vector
DIVF AC0,AC1 ;divide by norm
STF AC1,(R0)+ ;Store result
SOB R2,UNITV1 ;Loop until done
MOV (R1)+,(R0)+ ;Copy W.
MOV (R1),(R0) ; (two words long)
CCC ;Clear condition code
RTS PC ;Done
;172 -- 184 microseconds
CROSV: ;Vector ← Vector cross Vector
;X ← Y1Z2 - Y2Z1
;Y ← X2Z1 - X1Z2
;Z ← X1Y2 - X2Y1
;W ← W1W2
;AC0, 1, 2, 3, 4, 5 are garbaged by this routine.
MOV (R3),R2 ;R2 ← LOC[arg 2]
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV 4(R3),R1 ;R1 ← LOC[arg 1]. Must not pop R3 stack yet!
LDF 14(R1),AC0 ;AC0 ← W1
MULF 14(R2),AC0 ;AC0 ← W1W2
STF AC0,14(R0) ;Store AC0 → W
LDF 4(R1),AC0 ;AC0 ← Y1
LDF (R2),AC1 ;AC1 ← X2
LDF 4(R2),AC2 ;AC2 ← Y2
LDF (R1),AC3 ;AC3 ← X1
STF AC3,AC4 ;AC4 ← X1
STF AC0,AC5 ;AC5 ← Y1
MULF AC2,AC3 ;AC3 ← X1Y2
MULF AC1,AC0 ;AC0 ← X2Y1
SUBF AC0,AC3 ;AC3 ← X1Y2 - X2Y1
STF AC3,10(R0) ;Z ← AC3
LDF 10(R2),AC0 ;AC0 ← Z2
LDF 10(R1),AC3 ;AC3 ← Z1
MULF AC4,AC0 ;AC0 ← X1Z2
MULF AC3,AC1 ;AC1 ← X2Z1
SUBF AC0,AC1 ;AC1 ← X2Z1 - X1Z2
STF AC1,4(R0) ;Y ← AC1
LDF 10(R2),AC0 ;AC0 ← Z2
MULF AC5,AC0 ;AC0 ← Y1Z2
MULF AC2,AC3 ;AC3 ← Y2Z1
SUBF AC3,AC0 ;AC0 ← Y1Z2 - Y2Z1
STF AC0,(R0) ;X ← AC0
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
CCC ;Clear condition code
RTS PC ;Done
⊗ END OF COMMENTED-OUT PROCEDURES.
;Return vectors: SVMUL, TVMUL, VMAKE, VADD
;83 -- 91 microseconds
SVMUL: ;Vector ← Scalar * Vector. Interpreter routine
;X ← S*X, Y ← S*Y, Z ← S*Z, W ← W
MOV (R3)+,R2 ;R2 ← LOC[vector]
LDF @(R3)+,AC0 ;AC0 ← scalar;
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector block]
MOV #3,R1 ;R1 ← 3: How many fields to handle
SVM1: LDF (R2)+,AC1 ;AC1 ← next field of vector
MULF AC0,AC1 ;AC1 ← product
STF AC1,(R0)+ ;Store result
SOB R1,SVM1 ;Loop until all 3 fields done.
MOV (R2)+,(R0)+ ;Transfer W
MOV (R2)+,(R0)+ ; which is 2 words long.
CCC ;Clear condition code
RTS PC ;Done
VMAKE: ;Interpreter routine
LDF @(R3)+,AC1 ;Fetch X
LDF @(R3)+,AC2 ;Fetch Y
LDF @(R3)+,AC3 ;Fetch Z
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV ONE,(R0)+ ;Store W
CLR (R0) ;Store W (second word)
CCC ;Clear condition code
RTS PC ;Done
VADD: ;Interpreter routine
MOV (R3)+,R0 ;R0 ← LOC[arg 1]
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
LDF (R0)+,AC1 ;Calculate X
ADDF (R1)+,AC1 ;
LDF (R0)+,AC2 ;Calculate Y
ADDF (R1)+,AC2 ;
LDF (R0)+,AC3 ;Calculate Z
ADDF (R1)+,AC3 ;
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV ONE,(R0)+ ;Assume W is 1
CLR (R0) ;
CCC ;Clear condition code
RTS PC ;Done
;283 -- 324 microseconds
TVMUL: ;Vector ← Trans * Vector. Interpreter routine
MOV (R3),R2 ;R2 ← LOC[vector]
MOV 2(R3),R0 ;R0 ← LOC[trans]
CLRF AC1 ;X ← 0
CLRF AC2 ;Y ← 0
CLRF AC3 ;Z ← 0
MOV #4,R1 ;R1 ← How many columns left to go
TVM1: LDF (R2)+,AC0 ;AC0 ← field of vector
STF AC0,AC5 ;AC5 ← copy of AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC1 ;Add partial result to X
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC2 ;Add partial result to Y
LDF AC5,AC0 ;Restore AC0
MULF (R0)+,AC0 ;
ADDF AC0,AC3 ;Add partial result to Z.
ADD #4,R0 ;Skip bottom row
SOB R1,TVM1 ;Go back to do all 4 columns.
JSR PC,GETVEC ;R0 ← -(R3) ← LOC[new vector]
STF AC1,(R0)+ ;Store X
STF AC2,(R0)+ ;Store Y
STF AC3,(R0)+ ;Store Z
MOV -4(R2),(R0)+;Copy W from the vector
MOV -2(R2),(R0) ; (2 words long)
MOV (R3)+,2(R3) ;Put result cell where first argument was
TST (R3)+ ;Put stack pointer in right place
CCC ;Clear condition code
RTS PC ;Done
;Return a trans: TMAKE, TTMUL
TMAKE: ;Interpreter routine.
;All that is required is to take the rot part of the first argument,
;and the vector from the second part;
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
MOV (R3)+,-(SP) ;Push LOC[arg 2]
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
MOV #14,R2 ;R2 ← Count of how many copies to make
TMK1: MOV (R1)+,(R0)+ ;Transfer first half of floating word
MOV (R1)+,(R0)+ ;Transfer second half of floating word
SOB R2,TMK1 ;Repeat until done
MOV (SP)+,R1 ;R1 ← LOC[arg 2]
MOV #4,R2 ;R2 ← Count of how many copies to make
TMK2: MOV (R1)+,(R0)+ ;Transfer first half of floating word
MOV (R1)+,(R0)+ ;Transfer second half of floating word
SOB R2,TMK2 ;Repeat until done
CCC ;Clear condition code.
RTS PC ;Done.
TTMUL: ;Interpreter routine
;Multiplies two transes together. Takes advantage of the fact that
;last row is 0 0 0 1.
MOV (R3)+,R2 ;R2 ← LOC[arg 2]
MOV (R3)+,R1 ;R1 ← LOC[arg 1]
JSR PC,GETTRN ;R0 ← -(R3) ← LOC[new trans]
MOV R3,-(SP) ;Save R3
MOV R4,-(SP) ;Save R4
MOV #4,R4 ;Loop count for cols of answer
MOV R1,-(SP) ;Save a copy of R1
TTM2: LDF (R2)+,AC1 ;Pick up a column of arg2: First row
LDF (R2)+,AC2 ; Second row
LDF (R2)+,AC3 ; Third row
STF AC3,AC4 ; store in AC4
ADD #4,R2 ; Fourth row is zero
MOV #3,R3 ;Loop count for rows of answer
TTM1: LDF (R1),AC3 ;First col of arg 1
MULF AC1,AC3 ;
LDF 20(R1),AC0 ;Second col of arg 1
MULF AC2,AC0 ;
ADDF AC0,AC3 ;
LDF 40(R1),AC0 ;Third col of arg 1
MULF AC4,AC0 ;
ADDF AC0,AC3 ;
STF AC3,(R0)+ ;
ADD #4,R1 ;Move to next column of arg 1
SOB R3,TTM1 ;Repeat for first 3 rows of answer
CLR (R0)+ ;Last row of answer is zero
CLR (R0)+ ;
MOV (SP),R1 ;Reset R1 to point to first row of arg 1
SOB R4,TTM2 ;Repeat for all four columns of answer
LDF -20(R0),AC1 ;Add correction for last column, first row
ADDF 60(R1),AC1 ;
STF AC1,-20(R0) ;
LDF -14(R0),AC1 ;Add correction for last column, second row
ADDF 64(R1),AC1 ;
STF AC1,-14(R0) ;
LDF -10(R0),AC1 ;Add correction for last column, third row
ADDF 70(R1),AC1 ;
STF AC1,-10(R0) ;
MOV ONE,-4(R0) ;Make last col, last row get a one.
TST (SP)+ ;Pop the R1 temp
MOV (SP)+,R4 ;Restore R4
MOV (SP)+,R3 ;Restore R3
CCC ;Clear condition code
RTS PC ;Done
;Motion: MOVE
.IFNZ MOVING ;If this version is supposed to be able to move
MOVE: ;Interpreter routine
MOV #33,R0 ;Get a device block
JSR PC,GTFREE ;
MOV R0,R1 ;R1 ← address of device block
MOV R0,-(SP) ;Save a copy on the stack
MOV @IPC(R4),R0 ;R0 ← address of coefficient list
BMPIPC ;Bump IPC
JSR PC,MOVE ;Put a move on
TST R0 ;All well?
BEQ MOV1 ;Yes
HALERR MOVERR ;No, better complain.
MOV1: MOV (SP)+,R0 ;
JSR PC,RLFREE ;Get rid of the device block
CCC ;Clear condition code
RTS PC ;Return
MOVERR: ASCIE </SERVO ERROR. ERROR BITS IN R0/>
.IFF ;If not a moving version
HALERR MOVERR ;Can't move
CLR R0 ;
RTS PC ;Return
MOVERR: ASCIE </SORRY, THIS VERSION CAN'T EVEN LIFT A FINGER/>
.ENDC
;Condition monitors: CMMAK
.IFNZ ONMONS
COMMENT ⊗ This is the first, trivial version of condition monitors
(here refered to as c-m's). The basic operations are Creation,
Enabling, Disabling, Destruction. Creation causes a c-m control
block to be set up, and pointed to by the c-m variable. This block
has the following fields: ⊗
II == 0
XX CMSEVT ;The event used to awaken the tester
XX CMCEVT ;The event used to signal the conclusion
XX CMSTAT ;Status bits for the c-m
CMENB = 1 ;set => enabled
CMDES = 2 ;set => destroyed
CMCBSZ = II/2 ;Length in words of a c-m control block.
COMMENT ⊗ The once-only code of the checker is sprouted at priority 3
(it is an interpreter), and after initialization, it waits for the
gronking event CMSEVT. The body is sprouted at priority 1 (it should
reset itself to 0 after any critical section). Enabling signals
event CMSEVT and sets the enabled bit in CMSTAT. Disabling resets
the enabled bit, and the checker will wait on the CMSEVT for future
action. As long as the checker is enabled, it periodically wakes up,
checks its status bits. If the enable bit is reset, the checker
waits for CMSEVT. Else it checks the condition. If it is satisfied,
CMCEVT is signaled, and the checker disables itself. Otherwise, it
reschedules itself. If the destroy bit should ever be set in CMSTAT,
then the checker will destroy the event CMEVT, and the event CMSEVT.
Then it will reclaim the c-m control block and will dismiss, never to
return. (The pointer to the c-m in the environment should be zeroed
by the destroying angel.). ⊗
CMMAK: ;Interpreter routine
COMMENT ⊗ Takes three arguments, the offset of the nascent c-m, the
IPC of the checker code, and the IPC of the body code. ⊗
MOV @IPC(R4),R2 ;R2 ← offset
BMPIPC ;Bump IPC
ADD ENV(R4),R2 ;R2 ← Pointer into environment
TST (R2) ;Already something there?
BNE CMMERR ;Yes; this is a mistake
;Make a c-m control block
MOV #CMCBSZ,R0 ;
JSR PC,GTFREE ;R0 ← LOC[c-m control block]
MOV R0,(R2) ;Stuff into environment
EVMAK ;
MOV (SP)+,CMSEVT(R0) ;Make an event for CMSEVT
EVMAK ;
MOV (SP)+,CMCEVT(R0) ;Make an event for CMCEVT
CLR CMSTAT(R0) ;Disabled, undestroyed
MOV R0,-(SP) ;Save LOC[c-m control block]
;Prepare the checker
MOV @IPC(R4),R0 ;R0 ← IPC of checker code
BMPIPC ;Bump IPC
CLR R1 ;Checkers do not expire with events
JSR PC,SPAWN ;R0 ← process control block for checker
MOV PDBR4-PDBSTA(R0),R2;R2 ← PR4 (checker's interpeter status block)
MOV (SP),CMCB(R2);Stuff CMCB of the checker
FORK R0,#INTERP,#3;Cause the checker to be started. It will go into wait.
;Prepare the body
MOV @IPC(R4),R0 ;R0 ← IPC of body code
BMPIPC ;Bump IPC
CLR R1 ;Bodies do not expire with events
JSR PC,SPAWN ;R0 ← process control block for main body
MOV PDBR4-PDBSTA(R0),R2;R2 ← PR4 (body's interpreter status block)
MOV (SP)+,CMCB(R2);Stuff CMCB of the body
FORK R0,#INTERP,#1;Cause the body to be started. It will go into wait.
CCC ;Clear condition code
RTS PC ;Done
CMMERR: HALERR CMMMSG ;
SCC ;Set condition code
RTS PC ;
CMMMSG: ASCIE </TRYING TO CREATE EXISTENT CONDITION MONITOR/>
; CMENBL, CMDSBL, CMDEST, CMTRIG, CMSKED, CMUNCR, CMBWT
CMNEMS: ASCIE </TRYING TO TREAT NON-EXISTENT EVENT/>
CMENBL: ;Interpeter routine
; One argument, a level-offset pair for the c-m to enable.
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← pointer into environment
MOV (R0),R0 ;R0 ← pointer to c-m control block.
BEQ CMDERR ;If none, then error
BIS #CMENB,CMSTAT(R0) ;Set the enable bit
EVSIG CMSEVT(R0) ;Gronk the c-m
CCC ;Clear condition code
RTS PC ;Done
CMEERR: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMDSBL: ;Interpreter routine
; One argument, a level-offset pair for the c-m to disable.
MOV @IPC(R4),R0 ;R0 ← level-offset
BMPIPC ;Bump IPC
JSR PC,GETARG ;R0 ← pointer into environment
MOV (R0),R0 ;R0 ← pointer to c-m control block.
BEQ CMDERR ;If none, then error
BIC #CMENB,CMSTAT(R0) ;Clear the enable bit
CCC ;Clear condition code
RTS PC ;Done
CMDERR: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMDEST: ;Interpreter routine
COMMENT ⊗ Argument list. Each is an offset for the c-m to destroy.
The list is terminated with a zero entry. ⊗
MOV @IPC(R4),R0 ;R0 ← offset
BEQ CMDS1 ;If 0, then done
BMPIPC ;Bump IPC
ADD ENV(R4),R0 ;R0 ← pointer into environment
MOV (R0),R1 ;R1 ← LOC[c-m control block]
BEQ CMDSER ;If none, then error
BIS #CMDES,CMSTAT(R1) ;Set the destroy bit (RF -- necessary?)
EVKIL CMSEVT(R1);Wake up the checker with termination notice
CLR (R0) ;Remove c-m from environment
BR CMDEST ;Go do the next one.
CMDS1: BMPIPC ;Bump IPC the last time
CCC ;Clear condition code
RTS PC ;Done
CMDSER: HALERR CMNEMS ;
SCC ;Set condition code
RTS PC ;
CMTRIG: ;Interpeter routine
COMMENT ⊗ Should be executed only from a c-m checker. Causes the
body to be triggered, and disables the checker. The next
pseudo-instruction should be the scheduler, or a jump to it. ⊗
MOV CMCB(R4),R0 ;
EVSIG CMCEVT(R0);Trigger the body
CMTR1: EVTST CMSEVT(R0);Eat all signals enabling the checker.
BCC CMTR1 ;
BIC #CMENB,CMSTAT(R0) ;Clear the enable bit
CCC ;Clear condition code
RTS PC ;Done
CMSKED: ;Interpreter routine
COMMENT ⊗ Goes to sleep a while (currently, 100 milliseconds). Upon
awakening, checks the status bits of this checker, and either
dismisses, waits, or returns. ⊗
SLEEP #100 ;Sleep a while
MOV CMCB(R4),R0 ;
CMSK4: BIT #CMDES,CMSTAT(R0) ;Destroy bit set?
BEQ CMSK1 ;No
CMSK3: EVKIL CMCEVT(R0);Yes. Kill the triggering event. (The body will hear this.)
JMP TERMINATE ;Use the interpeter terminate routine.
CMSK1: BIT #CMENB,CMSTAT(R0) ;Enable bit set?
BNE CMSK2 ;Yes.
EVWAIT CMSEVT(R0);No. Wait until signaled.
BCS CMSK3 ;If the enabling event died, so must we.
BR CMSK4 ;Else start from the awakening point.
CMSK2: CCC ;Clear condition code
RTS PC ;Done
CMUNCR: ;Interpreter routine.
COMMENT ⊗ Used in body of c-m. Starts uncritical section. ⊗
MOV PCB(R4),R0 ;
CLR 2(R0) ;Clear word 1 of process control block to reset nominal
; priority to 0.
SETPRI #0 ;Set the priority to 0
CCC ;Clear condition code
RTS PC ;Done
CMBWT: ;Interpreter routine.
COMMENT ⊗ First operation in body of c-m. Waits on the CMCEVT. ⊗
MOV CMCB(R4),R0 ;
EVWAIT CMCEVT(R0);Wait until triggered.
BCC CMBW1 ;Event killed?
JMP TERMINATE ;Yes. Use the interpreter terminate routine.
CMBW1: CCC ;Clear condition code
RTS PC ;Done
.ENDC ; End of the ONMON material
;Debugging aids: PRINT
PRINT: ;Interpreter routine
MOV @IPC(R4),R0 ;R0 ← Address of string
BMPIPC ;Bump IPC
JSR PC,TYPSTR ;Type it out
CCC ;Clear condition code
RTS PC ;Done